home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / TSR / TPPOP18C / POPUP.PAS < prev    next >
Pascal/Delphi Source File  |  1988-12-14  |  5KB  |  154 lines
  1. {$A+,B-,D+,E+,F-,I+,L+,N+,O-,R-,S-,V-}
  2. Unit PopUp;
  3.  
  4. Interface
  5.  
  6. Uses Dos,Crt;
  7.  
  8. Const
  9.   RightShift = $0100;   { right shift key }
  10.   LeftShift  = $0200;   { left shift key  }
  11.   Control    = $0400;   { control key     }
  12.   ALT        = $0800;   { ALT key         }
  13.  
  14. Function  Installed(OurID : Byte) : Byte;
  15.  
  16. Procedure StayResident(OurID : Byte;Vector,HaltPtr : Pointer;PopKey : Word);
  17.  
  18. Procedure ReleaseEnvironment;   { releases the environment memory }
  19.  
  20. Implementation
  21.  
  22. Var
  23.   ProgramVector : Pointer;   { address of popup program           }
  24.   HaltVector    : Pointer;   { address of exit routine            }
  25.   oldDTA        : Pointer;   { interrupted DTA                    }
  26.   OurDTA        : Pointer;   { our DTA                            }
  27.   PrevBreak     : Boolean;   { previous BREAK status              }
  28.   EnvReleased   : Boolean;
  29.  
  30. Procedure ReleaseBlock(Segment : Word);
  31.  
  32. { Given a segment, releases the memory. }
  33.  
  34.   InLine($07/            { pop   es      }
  35.          $B4/$49/        { mov   ah,49h  }
  36.          $CD/$21);       { int   21h     }
  37.  
  38. Procedure ReleaseEnvironment;
  39.  
  40. { Releases the memory of the environment segment. }
  41.  
  42. Begin
  43.   If Not EnvReleased Then
  44.   Begin
  45.     ReleaseBlock(MemW[PrefixSeg:$002C]); { free the enviornment }
  46.     EnvReleased := True;
  47.   End;
  48. End;
  49.  
  50. Function GetBreakStatus : Boolean;
  51.  
  52.   InLine($B8/$00/$33/     { mov   ax,3300h }
  53.          $CD/$21/         { int   21h      }
  54.          $88/$D0);        { mov   al,dl    }
  55.  
  56. Procedure SetBreakStatus(Status : Boolean);
  57.  
  58.   InLine($5A/             { pop   dx       }
  59.          $B8/$01/$33/     { mov   ax,3301h }
  60.          $CD/$21);        { int   21h      }
  61.  
  62. Function GetDTAVec : Pointer;
  63.  
  64. { returns the segment:offset of the DTA }
  65.  
  66.   InLine($B4/$2F/    { mov   ah,2Fh  }
  67.          $CD/$21/    { int   21h     }
  68.          $89/$D8/    { mov   ax,bx   }
  69.          $8C/$C2);   { mov   dx,es   }
  70.  
  71. Procedure SetDTAVec(DTA : Pointer);
  72.  
  73. { sets the segment:offset of the DTA }
  74.  
  75.   InLine($8C/$D8/     { mov   ax,ds   }
  76.          $5A/         { pop   dx      }
  77.          $1F/         { pop   ds      }
  78.          $50/         { push  ax      }
  79.          $B4/$1A/     { mov   ah,1Ah  }
  80.          $CD/$21/     { int   21h     }
  81.          $1F);        { pop   ds      }
  82.  
  83. Procedure EntryInit;
  84.  
  85. Begin
  86.   PrevBreak := GetBreakStatus;      { save the BREAK status flag           }
  87.   SetBreakStatus(False);            { turn of BREAK                        }
  88.   OldDTA := GetDTAVec;              { get the current DTA address          }
  89.   SetDTAVec(OurDTA);                { set it to our own address            }
  90.   SwapVectors;                      { install our interrupt vectors        }
  91. End;
  92.  
  93. Procedure EntryExit;
  94.  
  95. Begin
  96.   SwapVectors;                      { restore the interrupt vectors        }
  97.   SetDTAVec(OldDTA);                { restore the DTA address              }
  98.   SetBreakStatus(PrevBreak);        { restore the original BREAKing status }
  99. End;
  100.  
  101. Procedure ReleaseProgram; Interrupt;
  102.  
  103. { Releases the program's memory.  We call this when unhooking the program. }
  104.  
  105. Begin
  106.   If HaltVector <> Nil Then
  107.   Begin
  108.     EntryInit;
  109.     InLine($FF/$1E/>HaltVector);
  110.     EntryExit;
  111.   End;
  112.   ReleaseBlock(PrefixSeg);
  113.   ReleaseEnvironment;
  114. End;
  115.  
  116. Procedure CriticalHandler; External; {$L crit.obj}
  117.  { internal routine - don't ever call direct }
  118.  
  119. Procedure CallPopUp; Interrupt;
  120.  
  121. { set some interrupt vectors and run the popup progams }
  122. { restore the interrupt vectors when done              }
  123.  
  124. Begin
  125.   EntryInit;
  126.   InLine($FF/$1E/>ProgramVector);   { call the user's procedure            }
  127.   EntryExit;
  128. End;
  129.  
  130. Function Installed(OurID : Byte) : Byte; External;
  131.  
  132. Procedure InitializePopUp(OurID : Byte;PopKey : Word); External;
  133.   { sets interrupt vectors }
  134. {$L popup.obj}
  135.  
  136. Procedure StayResident(OurID : Byte;Vector,HaltPtr : Pointer;PopKey : Word);
  137.  
  138. { saves some info and Terminated and Stays Resident }
  139.  
  140. Begin
  141.   OurDTA := GetDTAVec;              { save our DTA address               }
  142.   SetIntVec($23,@CriticalHandler);  { install our critical error handler }
  143.   SwapVectors;                      { restore all the vectors, save ours }
  144.   ProgramVector := Vector;          { save the user program address      }
  145.   HaltVector := HaltPtr;            { Our exit routine                   }
  146.   InitializePopUp(OurID,PopKey);    { install our interrupt vectors      }
  147.   Keep(0);                          { terminate and stay resident        }
  148. End;
  149.  
  150. Begin
  151.   CheckBreak := False;              { ignore the control break key }
  152.   EnvReleased := False;             { environment not yet released }
  153. End.
  154.